
;;############################################################################
;; datavis2.lsp
;; Copyright (c) 1991-2000 by Forrest W. Young
;; code to implement visualization of classification data
;; by using the emulated table data object.
;;############################################################################

(require "mosaic")

(defmeth mv-data-object-proto :visualize-class-data (resp-var-name)
  (call-next-method resp-var-name)) 

(defmeth emulated-table-data-object-proto :visualize-class-data (resp-var-name)
  (let* ((freq (send self :freq))
         (nways (send self :nways))
         (ways (send self :ways))
         (sources (send self :source-names))
        ; (resp-var (first (send self :active-variables '(numeric))))
         (resp-var resp-var-name)
         (resp-var-values (send self :variable resp-var))
         (design (combine (strcat resp-var "(Overall)") sources))
         (design (if (> nways 3) 
                     (combine design "Cells")
                     design))
         (design (if (= nways 3) 
                     (combine design (strcat (second design) "*" 
                                             (third design) "*" 
                                             (fourth design)))
                     design))
         (way-label-nums (mapcar #'list (iseq nways)))
         (binwidth-list (repeat nil (length design)))
         (first) (second)
         (old-sel 1)
         (grouped-data (send self :grouped-data 0))
         (table self)
         (cellfreqs (send self :cellfreqs))
         (nclasses (send self :nclasses))
         (last-effects-labels nil)
         (point-labels (send self :obs-labels));current-data
         (labels (first (send self :level-names)))
         (resplabels (mapcar #'(lambda (str) (strcat str " " resp-var)) labels))
;for mp & bg
         (cat-data (column-list (send self :active-data-matrix '(category))))
         (cat-varnames (send self :active-variables '(category)))

         (cat-freq-info (send table :convert-category-variables-to-freq 
                              cat-varnames (list resp-var)));resp-var-values
         (cat-cellfreqs (combine (first cat-freq-info)));cellfreqs diff order
         (cat-classes (second cat-freq-info))  ;= (send self :classes)
         (cat-nclasses (mapcar #'length cat-classes)) ;(send self :nclasses)
         (cat-resp-list (fourth cat-freq-info))
         (balanced (= (length (remove-duplicates cat-cellfreqs)) 1))
         (junk (send *watcher* :write-text 
                     (format nil "Creating SpreadPlot~%Making Histogram")))
         (hf (histofreq grouped-data :variable-labels resplabels
                        :new-x t :show nil))
         (junk (send *watcher* :write-text 
                     (format nil "Creating SpreadPlot~%Making Boxplot")))
         (bp (boxplot grouped-data :diamonds t :boxes t 
                           :mean-line t :median-line t
                           :show nil
                           :point-labels point-labels
                           :y-axis-label resp-var-name
                           :variable-labels labels))
         
         (dnl (name-list design :show nil :title "Sources" :help-only t))
         
         (qp (qplot  (first grouped-data) :reg-line t :show nil
                          :variable-label (first resplabels)))
         
         (qqp (qqplot (second grouped-data) (first  grouped-data)
                           :reg-line t :show nil
                           :nice-x-range (combine (send bp :range 1)
                                                  (third (send bp :y-axis)))
                           :nice-y-range (combine (send bp :range 1)
                                                  (third (send bp :y-axis)))
                           :variable-labels 
                           (list (second resplabels) (first resplabels))))
         
         (nl (name-list labels :show nil :title "Levels" :help-only t))
         (junk (send *watcher* :write-text 
                     (format nil "Creating SpreadPlot~%Making Layout")))
         (sp (spread-plot (matrix '(2 3) (list bp hf dnl qp qqp nl))
                          :show t :rel-widths '(1 1 .5)));.8 .4
         (plot-matrix (send sp :plot-matrix)))
    (send sp :title (format nil "~d-Way Classification Data SpreadPlot" nways))
    (send *watcher* :write-text 
                     (format nil "Creating SpreadPlot~%Making Methods"))
    (send bp :y-axis t t (third (send bp :y-axis)))
   ; (send bp :variable-label 1 (first (send self :active-variables '(numeric))))
    (send bp :linked t)
    (send bp :showing-labels t)
    (send bp :mouse-mode 'brushing)
    (send dnl :menu nil)
   ; (send dnl :fix-name-list)
    (dolist (i (iseq (1- nways)))
            (dolist (j (iseq (1+ i) (1- nways)))
                    (setf way-label-nums 
                          (add-element-to-list way-label-nums (list i j)))
                    ))
    (setf way-label-nums (add-element-to-list way-label-nums (iseq nways)))
    (defmeth dnl :do-select-click (&rest args)
      (apply #'call-next-method args)
      (when (send self :selection)
            (let* ((sel (first (send self :selection)))
                   (num (send self :num-points))
                   (nclasses (mapcar #'length (send table :classes)))
                   (ways (send table :ways))
                   (nways (send table :nways)))
              (cond
                ((= sel 0)
                 (send qqp :clear)
                 (send qqp :variable-label 0 " ")
                 (send qqp :variable-label 1 " ")
                 (send qp :new-plot (combine (send table :data-table))
                       :reg-line t
                       :variable-label resp-var-name)
                 (send hf :new-plot-data (combine (send table :data-table))
                       :binwidth (select binwidth-list sel)
                       :variable-labels resp-var)
                 (setf (select binwidth-list old-sel) (send hf :binwidth-list))
                 (setf old-sel sel)
                 (send bp :new-plot (combine (send table :data-table))
                       :point-labels point-labels
                       :variable-labels " ")
                 (send nl :clear))
                ((and (> nways 1) (< 0 sel (1- num)))

                 (setf grouped-data (send table :grouped-data (1- sel)))
                 (setf labels (nth (1- sel) (send table :level-names)))
                 (setf resplabels 
                       (mapcar #'(lambda (str) (strcat str " " resp-var ))
                               labels))
                 (setf point-labels 
                       (combine (send table :grouped-labels (1- sel))))
                 (setf (select binwidth-list old-sel) (send hf :binwidth-list))
                 (setf old-sel sel)
                 (send qqp :new-plot 
                       (second grouped-data)
                       (first grouped-data)
                       :reg-line t
                       :nice-x-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :nice-y-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :variable-labels (list (second resplabels) 
                                              (first  resplabels)))
                 (send qp :new-plot (first grouped-data)
                       :reg-line t
                       :variable-label (first resplabels))
                 (send nl :clear-points :draw nil)  
                 (send nl :add-points (length grouped-data)
                       :point-labels labels :draw nil)  
                ; (send nl :has-v-scroll (max (screen-size)))
                 
                 ;(when (> (min (mapcar #'length grouped-data)) 2) )
                 (send hf :new-plot-data grouped-data 
                       :binwidth (select binwidth-list sel)
                       :variable-labels resplabels)
                       
                 (send bp :new-plot grouped-data
                       :point-labels point-labels
                       :variable-labels labels)
                 )
                (t
                 (setf last-effects-labels
                       (if (= nways 1)
                           labels
                           (send table :cell-labels))) ;labels
                 (setf resplabels 
                       (mapcar #'(lambda (str) (strcat str resp-var))
                               last-effects-labels))
                 (setf point-labels (send table :obs-labels))
                 (setf first (select ways (first (select way-label-nums (1- sel)))))
                 (if (> nways 2)
                     (setf first (strcat first "*"
                           (select ways (third (select way-label-nums (1- sel)))))))
                 (setf second 
                       (strcat 
                        (select ways (second (select way-label-nums (1- sel))))
                        "/" resp-var-name))
                 (setf (select binwidth-list old-sel) (send hf :binwidth-list))
                 (setf old-sel sel)
                 (send bp :new-plot (send table :data-table)
                       :point-labels point-labels
                       :variable-labels last-effects-labels)
                 (send qp :new-plot (first (send table :data-table))
                       :reg-line t
                       :variable-label (first resplabels))
                 (send qqp :new-plot (second (send table :data-table))
                       (first (send table :data-table))
                       :reg-line t
                       :nice-x-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :nice-y-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :variable-labels 
                       (list (second resplabels) 
                             (first resplabels)))
                 (send hf :new-plot-data (send table :data-table)
                       :binwidth (select binwidth-list sel)
                       :variable-labels resplabels)
                 (send nl :clear-points :draw nil)                   
                 (send nl :add-points (length last-effects-labels)
                       :point-labels last-effects-labels :draw nil)
                ; (send nl :has-v-scroll (max (screen-size)))
                 )
                )

              )))
    
    (send qp :plot-buttons :mouse-mode t :new-y nil) 
    (send qp :linked t)
    (send nl :menu nil)
    ;(send nl :fix-name-list)
    ;(send nl :has-v-scroll (max (screen-size)))
 
    (defmeth nl :do-select-click (&rest args)
      (apply #'call-next-method args)
      (when (send self :selection)
            (let* ((xy (send self :selection))
                   (labels (send self :point-label 
                                 (iseq (send self :num-points))))
                   (resplabels (mapcar #'(lambda (str) (strcat str " " resp-var)) labels))
                   (y (sort-data (nth (first  xy) (send bp :data))))
                   (x (sort-data (/ (1+ (rank y)) (1+ (length y))))))
              (send hf :show-new-var "X" 
                    (select labels (first xy)) :variable-num (first xy))
              (send qp :new-plot y :reg-line t
                    :variable-label (nth (first xy) resplabels))
              (when (> (length xy) 1)
                    (setf x (sort-data (nth (second xy) (send bp :data))))
                    (send qqp :new-plot x y :reg-line t
                          :nice-x-range (combine (send bp :range 1)
                                                 (third (send bp :y-axis)))
                          :nice-y-range (combine (send bp :range 1)
                                                 (third (send bp :y-axis)))
                          :variable-labels (list
                                            (nth (second xy) resplabels)
                                            (nth (first  xy) resplabels)))))))
    
    (defmeth self :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Classification and Table Data. In this SpreadPlot clicking on entries in the Sources and Levels windows changes what is displayed in the other plot windows. Clicking on a Source entry will change the data source for which information is displayed in the other windows. Clicking on a Levels entry will change the level of the source for which information is displayed in the Q-plot and QQ-plot.~2%"))
      (show-plot-help)
      (send spreadplot-proto :spreadplot-help :nothing t :flush nil))

    (defmeth qp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a quantile plot (Q-plot) or normal-probability plot (NP-plot) for a subset of the observations. The subset is formed by the level choosen in the LEVELS window. The choice of subsets is itself determined by the source choosen in the SOURCES window. By clicking on various LEVELS and SOURCES it is possible to see subsets for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (send qqp :plot-buttons :new-x nil :new-y nil :mouse-mode nil)
  ;:margin '(0 17 0 20)
    (defmeth qqp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a quantile-quantile plot (QQ-plot) formed from a pair of subsets of the observations. The pair of subsets is formed by the levels choosen in the LEVELS window. You make the choice by shift-clicking on two levels, or dragging across two levels. The choice of levels is itself determined by the source choosen in the SOURCES window. By clicking on various LEVELS and SOURCES it is possible to see subsets for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth bp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a side-by-side Box, Diamond and Dot plot for each of the levels of a source in your data. The choice of sources is determined by clicking in the SOURCES window. By clicking on various SOURCES it is possible to see side-by-side box-plots for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth dnl :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This window displays sources of information in the data. A source is either the OVERALL data, a main way of the data, or a combination of two or more of the ways of the data. By clicking on a source in the SOURCES window it is possible to see side-by-side box, diamond and dot plots of the levels of the source. In addition, the LEVELS window will display the levels of the choosen source, which effects the specific Q-plots and QQ-plots that can be shown.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth nl :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This window displays the levels of a choosen data source. (The OVERALL source has only one level. It is not shown.) If you click on one level in the LEVELS window you will get a Q-plot of that level. If you shift-click (or drag) on a pair of levels, you will get a QQ-plot of the pair of levels.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    ;(send nl :has-v-scroll (max (screen-size)))
    ;(send dnl :has-v-scroll (max (screen-size)))
#+macintosh
    (when (> xls-minor-release 50)
          (mapcar #'(lambda (plot)
                      (apply #'send plot :location 
                             (- (send plot :location)
                                (list -3 window-decoration-height))))
                  (list bp dnl qp qqp nl)))
    (send *watcher* :write-text 
          (format nil "Creating SpreadPlot~%Showing Cells"))
    (send nl  :has-v-scroll nil)
    (send dnl :has-v-scroll nil)
    (send dnl :selection '(1))
    (send dnl :do-select-click 18 25 nil nil)
    (send nl  :selection '(0))
    (send nl  :do-select-click 18 5 nil nil)
    (send sp  :show-spreadplot)
    (send dnl :do-select-click 18 25 nil nil)
    (send nl  :do-select-click 18 5 nil nil)
    (send *watcher* :hide-window)
    ))